library(NNbenchmark)
library(kableExtra)
library(dplyr)
library(stringr)
options(scipen = 999)
if(dir.exists("D:/GSoC2020/Results/2020run04/"))
{
odir <- "D:/GSoC2020/Results/2020run04/"
}else
odir <- "../results_2020_gsoc2020/"
resultfile <- list.files(odir, pattern = "-results.csv", full.names = TRUE)
nonlargeresult <- grep("Wood", resultfile, invert = TRUE, value=TRUE)
lf <- lapply(nonlargeresult, csv::as.csv)
names(lf) <- names(NNdatasets)
#lf <- lf[c(1:4,6,7,10,12)]
gfr <- lapply(lf, function(dfr) cbind(
ds = str_remove(str_extract(dfr$event, "\\w+_"), "_"),
pfa = str_sub(str_remove(dfr$event, str_extract(dfr$event, "\\w+_")), 1, -4),
run = str_sub(dfr$event, -2, -1),
dfr[,c("RMSE","MAE","WAE","time")]
))
yfr <- lapply(gfr, function(dfr) {
as.data.frame(dfr %>%
group_by(pfa) %>%
summarise(time.mean = mean(time),
RMSE.min = min(RMSE),
RMSE.med = median(RMSE),
RMSE.d51 = median(RMSE) - min(RMSE),
MAE.med = median(MAE),
WAE.med = median(WAE)
)
)})
## `summarise()` ungrouping output (override with `.groups` argument)
## `summarise()` ungrouping output (override with `.groups` argument)
## `summarise()` ungrouping output (override with `.groups` argument)
## `summarise()` ungrouping output (override with `.groups` argument)
## `summarise()` ungrouping output (override with `.groups` argument)
## `summarise()` ungrouping output (override with `.groups` argument)
## `summarise()` ungrouping output (override with `.groups` argument)
## `summarise()` ungrouping output (override with `.groups` argument)
## `summarise()` ungrouping output (override with `.groups` argument)
## `summarise()` ungrouping output (override with `.groups` argument)
## `summarise()` ungrouping output (override with `.groups` argument)
## `summarise()` ungrouping output (override with `.groups` argument)
yfr <- lapply(yfr, function(dfr) transform(dfr, npfa = 1:nrow(dfr)))
Those csv are used in the supplementary materials of the paper.
for(j in 1:length(yfr))
write.csv(yfr[[j]], file=paste0(odir, names(yfr)[j], "-result-summary.csv"), row.names = FALSE)
rankMOFtime <- function(dfr) {
dfrtime <- dfr[order(dfr$time.mean),]
dfrRMSE <- dfr[order(dfr$RMSE.min, dfr$time.mean, dfr$RMSE.med),]
dfrRMSEmed <- dfr[order(dfr$RMSE.med, dfr$RMSE.min, dfr$time.mean),]
dfrRMSEd51 <- dfr[order(dfr$RMSE.d51),]
dfrMAE <- dfr[order(dfr$MAE.med),]
dfrWAE <- dfr[order(dfr$WAE.med),]
transform(dfr,
time.rank = order(dfrtime$npfa),
RMSE.rank = order(dfrRMSE$npfa),
RMSEmed.rank = order(dfrRMSEmed$npfa),
RMSEd51.rank = order(dfrRMSEd51$npfa),
MAE.rank = order(dfrMAE$npfa),
WAE.rank = order(dfrWAE$npfa)
)
}
sfr <- lapply(yfr, rankMOFtime)
sfrwide <- do.call(cbind, sfr)
sfr.time <- sfrwide[, c(grep("time.rank", colnames(sfrwide)))]
time.score <- rank(apply(sfr.time, 1, sum), ties.method = "min")
sfr.RMSE <- sfrwide[, c(grep("RMSE.rank", colnames(sfrwide)))]
RMSE.score <- rank(apply(sfr.RMSE, 1, sum), ties.method = "min")
sfr.RMSEmed <- sfrwide[, c(grep("RMSEmed.rank", colnames(sfrwide)))]
RMSEmed.score <- rank(apply(sfr.RMSEmed, 1, sum), ties.method = "min")
sfr.RMSEd51 <- sfrwide[, c(grep("RMSEd51.rank", colnames(sfrwide)))]
RMSEd51.score <- rank(apply(sfr.RMSEd51, 1, sum), ties.method = "min")
sfr.MAE <- sfrwide[, c(grep("MAE.rank", colnames(sfrwide)))]
MAE.score <- rank(apply(sfr.MAE, 1, sum), ties.method = "min")
sfr.WAE <- sfrwide[, c(grep("WAE.rank", colnames(sfrwide)))]
WAE.score <- rank(apply(sfr.WAE, 1, sum), ties.method = "min")
scoredfr0 <- data.frame(sfr$mDette[,"pfa",drop=FALSE],
# scoredfr0 <- data.frame(sfr$uNeuroOne[,c("pfa")],
time.score,
RMSE.score,
RMSEmed.score,
RMSEd51.score,
MAE.score,
WAE.score)
scoredfr <- scoredfr0[order(scoredfr0$RMSE.score),]
rownames(scoredfr) <- NULL
kable(scoredfr)%>%
kable_styling(bootstrap_options = c("striped", "hover", "condensed"))
| pfa | time.score | RMSE.score | RMSEmed.score | RMSEd51.score | MAE.score | WAE.score |
|---|---|---|---|---|---|---|
| nlsr::nlxb_none | 20 | 1 | 2 | 10 | 2 | 4 |
| rminer::fit_none | 14 | 2 | 1 | 6 | 1 | 1 |
| nnet::nnet_none | 3 | 3 | 2 | 17 | 4 | 5 |
| MachineShop::fit_none | 6 | 4 | 8 | 20 | 8 | 8 |
| validann::ann_BFGS | 36 | 5 | 4 | 9 | 3 | 3 |
| traineR::train.nnet_none | 4 | 6 | 5 | 14 | 5 | 2 |
| radiant.model::nn_none | 10 | 7 | 10 | 32 | 12 | 11 |
| validann::ann_CG | 60 | 8 | 6 | 13 | 6 | 7 |
| CaDENCE::cadence.fit_optim | 46 | 9 | 26 | 48 | 19 | 32 |
| brnn::brnn_Gauss-Newton | 7 | 10 | 14 | 10 | 16 | 14 |
| caret::avNNet_none | 16 | 11 | 9 | 21 | 9 | 9 |
| h2o::h2o.deeplearning_first-order | 49 | 12 | 7 | 7 | 7 | 6 |
| validann::ann_L-BFGS-B | 37 | 13 | 13 | 35 | 15 | 13 |
| EnsembleBase::Regression.Batch.Fit_none | 5 | 14 | 15 | 28 | 14 | 15 |
| monmlp::monmlp.fit_BFGS | 26 | 15 | 11 | 19 | 10 | 12 |
| qrnn::qrnn.fit_none | 27 | 16 | 18 | 25 | 11 | 31 |
| automl::automl_train_manual_trainwgrad_adam | 48 | 17 | 19 | 34 | 17 | 18 |
| minpack.lm::nlsLM_none | 14 | 17 | 12 | 5 | 13 | 10 |
| RSNNS::mlp_Rprop | 24 | 19 | 28 | 52 | 26 | 30 |
| deepnet::nn.train_BP | 22 | 20 | 17 | 36 | 20 | 17 |
| RSNNS::mlp_SCG | 31 | 21 | 20 | 27 | 21 | 22 |
| neuralnet::neuralnet_rprop- | 19 | 22 | 22 | 45 | 23 | 23 |
| keras::fit_adamax | 50 | 23 | 16 | 23 | 17 | 16 |
| neuralnet::neuralnet_rprop+ | 18 | 24 | 23 | 47 | 24 | 25 |
| RSNNS::mlp_Std_Backpropagation | 23 | 25 | 24 | 23 | 25 | 26 |
| RSNNS::mlp_BackpropChunk | 27 | 26 | 31 | 37 | 30 | 28 |
| automl::automl_train_manual_trainwgrad_RMSprop | 47 | 27 | 30 | 44 | 32 | 29 |
| RSNNS::mlp_BackpropWeightDecay | 29 | 28 | 21 | 31 | 22 | 19 |
| neuralnet::neuralnet_sag | 40 | 29 | 46 | 59 | 45 | 50 |
| RSNNS::mlp_BackpropMomentum | 25 | 30 | 24 | 26 | 26 | 21 |
| keras::fit_adam | 43 | 31 | 27 | 42 | 28 | 20 |
| neuralnet::neuralnet_slr | 30 | 32 | 35 | 39 | 36 | 41 |
| ANN2::neuralnetwork_rmsprop | 13 | 33 | 29 | 33 | 30 | 24 |
| AMORE::train_ADAPTgdwm | 16 | 34 | 33 | 40 | 29 | 36 |
| ANN2::neuralnetwork_adam | 12 | 35 | 32 | 30 | 33 | 27 |
| keras::fit_nadam | 44 | 36 | 37 | 55 | 38 | 41 |
| keras::fit_adagrad | 58 | 37 | 43 | 51 | 42 | 38 |
| AMORE::train_ADAPTgd | 9 | 38 | 34 | 12 | 35 | 33 |
| automl::automl_train_manual_trainwpso | 57 | 39 | 42 | 49 | 41 | 40 |
| keras::fit_adadelta | 59 | 40 | 36 | 18 | 34 | 34 |
| validann::ann_Nelder-Mead | 56 | 41 | 43 | 46 | 44 | 43 |
| AMORE::train_BATCHgd | 39 | 42 | 40 | 28 | 43 | 35 |
| AMORE::train_BATCHgdwm | 41 | 43 | 37 | 15 | 40 | 37 |
| keras::fit_sgd | 51 | 44 | 47 | 43 | 48 | 46 |
| ANN2::neuralnetwork_sgd | 10 | 45 | 40 | 22 | 39 | 39 |
| deepdive::deepnet_adam | 33 | 46 | 39 | 1 | 37 | 44 |
| neuralnet::neuralnet_backprop | 35 | 47 | 45 | 16 | 45 | 45 |
| monmlp::monmlp.fit_Nelder-Mead | 32 | 48 | 49 | 50 | 47 | 47 |
| keras::fit_rmsprop | 38 | 49 | 54 | 58 | 54 | 54 |
| CaDENCE::cadence.fit_Rprop | 55 | 50 | 55 | 60 | 52 | 56 |
| deepdive::deepnet_rmsProp | 34 | 51 | 48 | 4 | 49 | 48 |
| RSNNS::mlp_BackpropBatch | 42 | 52 | 51 | 41 | 51 | 51 |
| snnR::snnR_none | 8 | 53 | 50 | 8 | 50 | 49 |
| validann::ann_SANN | 21 | 54 | 52 | 53 | 53 | 53 |
| CaDENCE::cadence.fit_psoptim | 53 | 55 | 56 | 53 | 56 | 57 |
| deepdive::deepnet_momentum | 54 | 56 | 53 | 3 | 55 | 52 |
| RSNNS::mlp_Quickprop | 44 | 57 | 58 | 38 | 57 | 58 |
| elmNNRcpp::elm_train_extremeML | 1 | 58 | 59 | 57 | 59 | 59 |
| deepdive::deepnet_gradientDescent | 52 | 59 | 57 | 2 | 58 | 55 |
| ELMR::OSelm_train.formula_extremeML | 2 | 60 | 60 | 56 | 60 | 60 |
rkperalgo <- sfrwide[order(scoredfr0$RMSE.score),c(1, grep("RMSE.rank", colnames(sfrwide)))]
pkgname <- sapply(strsplit(rkperalgo$mDette.pfa, "::"), head, n=1)
n <- NROW(rkperalgo)
rkproba <- sapply(1:n, function(j)
sapply(1:n, function(r) mean(as.numeric(rkperalgo[j, -1]) == r))
)
colnames(rkproba) <- paste0(pkgname, ".", rownames(rkperalgo))
BandW <- c("white", "grey90", "grey70", "grey50", "grey30", "grey10")
#png(paste0(odir, "/","scoreprobperpkgBnW.png"), width = 800, height = 800)
reshtm <- heatmap(rkproba, Rowv=NA, Colv=NA, xlab="Package:Algorithm", ylab="RMSE score",
main="Score probabilities over 12 packages", margins = c(6, 3), scale="none",
col=BandW)
legend("topleft", fill = BandW, leg=0:5/5)
#dev.off()
## =====================================
## GLOBAL SCORE APPLIED TO EVERY DATASET
## =====================================
merge_sfr_dfr <- function(x, y) {
z <- cbind(
x[,c("npfa","pfa","time.mean","RMSE.min","time.rank","RMSE.rank")],
y[,c("time.score","RMSE.score")]
)
z[order(z$RMSE.score),]
}
zfr <- lapply(sfr, merge_sfr_dfr, y = scoredfr0)
#str(zfr)
#str(sfr)
## =========================
## GRAPHIC RMSEscore_RMSEmin
## =========================
op <- par(mfrow = c(length(yfr)/2,2), las = 1, mar = c(0,4,0,0), oma = c(1,1,3,1))
for (j in seq_along(zfr)) {
names(zfr)[j]
plot(log1p(zfr[[j]][, "RMSE.score"]), log1p(zfr[[j]][, "RMSE.min"]),
xlab = "RMSE.score (log1p)", ylab = "RMSE.min (log1p)", # main = names(zfr)[j],
las = 1, col = 0, xaxt = "n")
mtext(names(zfr)[j], line = -1.2, cex = 0.8)
text(log1p(zfr[[j]][, "RMSE.score"]), log1p(zfr[[j]][, "RMSE.min"]),
labels = zfr[[j]][, "RMSE.score"])
}
mtext("x=log1p(RMSE.score) (global) y=log1p(RMSE.min) (per dataset)", outer = TRUE, line = 1)
op <- par(mfrow = c(length(yfr)/2,2), las = 1, mar = c(0,4,0,0), oma = c(1,1,3,1))
for (j in seq_along(zfr)) {
names(zfr)[j]
plot(zfr[[j]][, "RMSE.score"], zfr[[j]][, "RMSE.min"],
xlab = "RMSE.score", ylab = "RMSE.min", # main = names(zfr)[j],
las = 1, col=0, xaxt = "n", pch=as.character(zfr[[j]][, "RMSE.score"]))
mtext(names(zfr)[j], line = -1.2, cex = 0.8)
text(zfr[[j]][, "RMSE.score"], zfr[[j]][, "RMSE.min"],
labels = zfr[[j]][, "RMSE.score"])
}
mtext("x=RMSE.score (global) y=RMSE.min (per dataset)", outer = TRUE, line = 1)
## ==============================
## GRAPHIC RMSEscore_timemean
## ==============================
op <- par(mfrow = c(length(yfr)/2,2), las = 1, mar = c(0,0,0,0), oma = c(1,1,3,1))
for (j in seq_along(zfr)) {
names(zfr)[j]
plot(log1p(zfr[[j]][, "RMSE.score"]), log1p(zfr[[j]][, "time.mean"]),
xlab = "RMSE.score (log1p)", ylab = "time.mean (log1p)",
las = 1, col = 0, xaxt = "n", yaxt = "n")
mtext(names(zfr)[j], line = -1.2, cex = 0.8)
text(log1p(zfr[[j]][, "RMSE.score"]), log1p(zfr[[j]][, "time.mean"]),
labels = zfr[[j]][, "RMSE.score"])
}
mtext("x=log1p(RMSE.score) (global) y=log1p(time.mean) (per dataset)", outer = TRUE, line = 1)
op <- par(mfrow = c(length(yfr)/2,2), las = 1, mar = c(0,4,0,0), oma = c(1,1,3,1))
for (j in seq_along(zfr)) {
names(zfr)[j]
plot(zfr[[j]][, "RMSE.score"], zfr[[j]][, "time.mean"],
xlab = "RMSE.score", ylab = "time.mean",
las = 1, col = 0, xaxt = "n")
mtext(names(zfr)[j], line = -1.2, cex = 0.8)
text(zfr[[j]][, "RMSE.score"], zfr[[j]][, "time.mean"],
labels = zfr[[j]][, "RMSE.score"])
}
mtext("x=RMSE.score (global) y=time.mean (per dataset)", outer = TRUE, line = 1)
## =======================================
## GRAPHIC RMSEmin_timemean - 49 algos
## =======================================
op <- par(mfrow = c(length(yfr)/2,2), las = 1, mar = c(0,0,0,0), oma = c(1,1,3,1))
for (j in seq_along(zfr)) {
names(zfr)[j]
plot(log1p(zfr[[j]][, "RMSE.min"]), log1p(zfr[[j]][, "time.mean"]),
xlab = "RMSE.min", ylab = "time.mean", #Â main = names(zfr)[j],
las = 1, col = 0, xaxt = "n", yaxt = "n")
mtext(names(zfr)[j], line = -1.2, cex = 0.8)
text(log1p(zfr[[j]][, "RMSE.min"]), log1p(zfr[[j]][, "time.mean"]),
labels = zfr[[j]][, "RMSE.score"])
}
mtext("x=RMSE.min (per dataset) y=time.mean (per dataset) 49 algos", outer = TRUE, line = 1)
## =======================================
## GRAPHIC RMSEmin_timemean - 12 algos
## =======================================
op <- par(mfrow = c(length(yfr)/2,2), las = 1, mar = c(0,0,0,0), oma = c(1,1,3,1))
for (j in seq_along(zfr)) {
names(zfr)[j]
plot(log1p(zfr[[j]][1:12, "RMSE.min"]), log1p(zfr[[j]][1:12, "time.mean"]),
xlab = "RMSE.min", ylab = "time.mean", #Â main = names(zfr)[j],
las = 1, col = 0, xaxt = "n", yaxt = "n")
mtext(names(zfr)[j], line = -1.2, cex = 0.8)
text(log1p(zfr[[j]][1:12, "RMSE.min"]), log1p(zfr[[j]][1:12, "time.mean"]),
labels = zfr[[j]][1:12, "RMSE.score"])
}
mtext("x=RMSE.min (per dataset) y=time.mean (per dataset) 12 algos", outer = TRUE, line = 1)
## =======================================
## GRAPHIC RMSEmin_timemean - 09 algos
## =======================================
op <- par(mfrow = c(length(yfr)/2,2), las = 1, mar = c(0,0,0,0), oma = c(1,1,3,1))
for (j in seq_along(zfr)) {
names(zfr)[j]
plot(log1p(zfr[[j]][1:9, "RMSE.min"]), log1p(zfr[[j]][1:9, "time.mean"]),
xlab = "RMSE.min", ylab = "time.mean", #Â main = names(zfr)[j],
las = 1, col = 0, xaxt = "n", yaxt = "n")
mtext(names(zfr)[j], line = -1.2, cex = 0.8)
text(log1p(zfr[[j]][1:9, "RMSE.min"]), log1p(zfr[[j]][1:9, "time.mean"]),
labels = zfr[[j]][1:9, "RMSE.score"])
}
mtext("x=RMSE.min (per dataset) y=time.mean (per dataset) 9 algos", outer = TRUE, line = 1)
## THE END
## THE END
myscore <- c(rep(2, 10), rep(1, NROW(zfr[[1]])-10))
myds <- seq_along(zfr)[names(zfr) %in% c("mIshigami", "uDreyfus1")]
png("mIshigami-uDreyfus1-RMSEmin.png", width = 1000, height = 500)
op <- par(mfrow = c(1,2), las = 1, mar = c(0,3,0,0), oma = c(1,1,3,2))
for (j in myds) {
plot(cumsum(myscore), zfr[[j]][, "RMSE.min"],
xlab = "RMSE.score", ylab = "RMSE.min",
ylim=c(.9*min(zfr[[j]][, "RMSE.min"]), 1.1*max(zfr[[j]][, "RMSE.min"])),
las = 1, col=0, xaxt = "n", pch=as.character(zfr[[j]][, "RMSE.score"]))
mtext(names(zfr)[j], line = -1.2, cex = 1.2)
text(cumsum(myscore), zfr[[j]][, "RMSE.min"],
labels = zfr[[j]][, "RMSE.score"])
grid()
}
mtext("RMSE.min (per dataset) against RMSE.score (global)", outer = TRUE, line = 1)
dev.off()
## quartz_off_screen
## 2
myscore <- c(rep(2, 10), rep(1, NROW(zfr[[1]])-30), rep(2, 20))
#myscore <- rep(2, NROW(zfr[[1]]))
png("mIshigami-uDreyfus1-timmean.png", width = 1000, height = 500)
op <- par(mfrow = c(1,2), las = 1, mar = c(0,3,0,0), oma = c(1,1,3,2))
for (j in myds) {
#myscore <- rep(1, NROW(zfr[[j]]))
#myscore[zfr[[j]][, "time.mean"] <= 0.5] <- 3
plot(cumsum(myscore), zfr[[j]][, "time.mean"],
xlab = "RMSE.score", ylab = "time.mean",
ylim=c(.9*min(zfr[[j]][, "time.mean"]), 1.1*max(zfr[[j]][, "time.mean"])),
las = 1, col=0, xaxt = "n", pch=as.character(zfr[[j]][, "RMSE.score"]))
mtext(names(zfr)[j], line = -1.2, cex = 1.2)
text(cumsum(myscore), zfr[[j]][, "time.mean"],
labels = zfr[[j]][, "RMSE.score"])
grid()
}
mtext("time.mean (per dataset) against RMSE.score (global)", outer = TRUE, line = 1)
dev.off()
## quartz_off_screen
## 2